{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit Profile;

interface

uses
  Classes, SysUtils, TestCore, MiscUtils;

type
  TWorkConfiguration = class
  private
    FQuestionsPerSection: Integer; { 0 = all }
    FDurationMinutes: Integer; { 0 = no limit }
    FShuffleQuestions: Boolean;
    FEditableAnswers: Boolean;
    FWeightCues: Boolean;
    FInstantAnswerCorrectness: Boolean;
    FInstantTotalPercentCorrect: Boolean;
    FBrowsableQuestions: Boolean;
    FLabelFilter: String;
    FUseLabelFilter: Boolean;
    procedure SetQuestionsPerSection(Value: Integer);
    procedure SetDurationMinutes(Value: Integer);
  public
    property BrowsableQuestions: Boolean read FBrowsableQuestions write FBrowsableQuestions;
    property DurationMinutes: Integer read FDurationMinutes write SetDurationMinutes;
    property EditableAnswers: Boolean read FEditableAnswers write FEditableAnswers;
    property InstantAnswerCorrectness: Boolean read FInstantAnswerCorrectness write FInstantAnswerCorrectness;
    property InstantTotalPercentCorrect: Boolean read FInstantTotalPercentCorrect write FInstantTotalPercentCorrect;
    property LabelFilter: String read FLabelFilter write FLabelFilter;
    property QuestionsPerSection: Integer read FQuestionsPerSection write SetQuestionsPerSection;
    property ShuffleQuestions: Boolean read FShuffleQuestions write FShuffleQuestions;
    property UseLabelFilter: Boolean read FUseLabelFilter write FUseLabelFilter;
    property WeightCues: Boolean read FWeightCues write FWeightCues;
  end;

  TResultPolicy = class
  private
    FResultsAvailable: Boolean;

    FPercentCorrect: Boolean;
    FPoints: Boolean;
    FMark: Boolean;

    FQuestionResultsAvailable: Boolean;
    FQuestionPercentCorrect: Boolean;
    FQuestionPoints: Boolean;
    FQuestionCorrectAnswer: Boolean;

    FSectionResultsAvailable: Boolean;
    FSectionPercentCorrect: Boolean;
    FSectionPoints: Boolean;
    FSectionQuestionCount: Boolean;
    FSectionQuestionList: Boolean;
  public
    procedure Assign(Source: TResultPolicy);

    property Mark: Boolean read FMark write FMark;
    property PercentCorrect: Boolean read FPercentCorrect write FPercentCorrect;
    property Points: Boolean read FPoints write FPoints;
    property QuestionCorrectAnswer: Boolean read FQuestionCorrectAnswer write FQuestionCorrectAnswer;
    property QuestionPercentCorrect: Boolean read FQuestionPercentCorrect write FQuestionPercentCorrect;
    property QuestionPoints: Boolean read FQuestionPoints write FQuestionPoints;
    property QuestionResultsAvailable: Boolean read FQuestionResultsAvailable write FQuestionResultsAvailable;
    property ResultsAvailable: Boolean read FResultsAvailable write FResultsAvailable;
    property SectionPercentCorrect: Boolean read FSectionPercentCorrect write FSectionPercentCorrect;
    property SectionPoints: Boolean read FSectionPoints write FSectionPoints;
    property SectionQuestionCount: Boolean read FSectionQuestionCount write FSectionQuestionCount;
    property SectionQuestionList: Boolean read FSectionQuestionList write FSectionQuestionList;
    property SectionResultsAvailable: Boolean read FSectionResultsAvailable write FSectionResultsAvailable;
  end;

  TMarkScaleItem = class
  private
    FLowerBound: Single;
    FMark: String;
  public
    procedure Assign(Source: TMarkScaleItem);
    function Clone: TMarkScaleItem;

    property LowerBound: Single read FLowerBound write FLowerBound;
    property Mark: String read FMark write FMark;
  end;
  TMarkScaleItemList = TGenericObjectList<TMarkScaleItem>;

  TMarkScale = class
  private
    FItems: TMarkScaleItemList; { sorted by LowerBound }
    function GetItemCount: Integer;
    function GetMarks(Index: Integer): String;
    procedure CheckItemIndex(Index: Integer);
    function GetLowerBounds(Index: Integer): Single;
  public const
    MAX_ITEMS = 20;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetItems(Items: TMarkScaleItemList);
    procedure GetItems(Items: TMarkScaleItemList);
    function PartRightToItemIndex(PartRight: Single): Integer;
    function PartRightToMark(PartRight: Single): String;
    function IsEmpty: Boolean;

    property ItemCount: Integer read GetItemCount;
    property LowerBounds[Index: Integer]: Single read GetLowerBounds;
    property Marks[Index: Integer]: String read GetMarks;
  end;

  TProfile = class
  private
    FTitle: String;
    FConfiguration: TWorkConfiguration;
    FModifierList: TModifierList;
    FResultPolicy: TResultPolicy;
    FMarkScale: TMarkScale;
  public
    constructor Create;
    destructor Destroy; override;
    procedure GetDescription(Strings: TStrings);

    property Configuration: TWorkConfiguration read FConfiguration;
    property MarkScale: TMarkScale read FMarkScale;
    property ModifierList: TModifierList read FModifierList;
    property ResultPolicy: TResultPolicy read FResultPolicy;
    property Title: String read FTitle write FTitle;
  end;

  TProfileList = class
  private type
    TRawProfileList = TGenericObjectList<TProfile>;
  private
    FProfiles: TRawProfileList;
    function GetCount: Integer;
    function GetProfiles(Index: Integer): TProfile;
    procedure CheckProfileIndex(Index: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Profile: TProfile);
    function Extract(Index: Integer): TProfile;

    property Count: Integer read GetCount;
    property Profiles[Index: Integer]: TProfile read GetProfiles; default;
  end;

implementation

resourcestring
  SMarkScaleError = 'Incorrect grading scale.';
  SAllQuestions = 'All questions';
  SQuestionsPerSection = 'Questions from each section: %d';
  SShuffleQuestions = 'Shuffle questions';
  SDurationMinutes = '%d minutes';
  SEditableAnswers = 'Allow editing answers';
  SInstantAnswerCorrectness = 'Instantly show if the answer is correct';
  SInstantTotalPercentCorrect = 'Show current result in percent';
  SBrowsableQuestions = 'Allow browsing through questions';
  SWeightCues = 'Reflect question weights on diagram';
  SResultsAvailable = 'Show results after testing:';
  SPercentCorrect = 'Result in percent';
  SPoints = 'Points earned';
  SMark = 'Grade';
  SQuestionResultsAvailable = 'Question details:';
  SQuestionPercentCorrect = 'Outcome (right/wrong)';
  SQuestionPoints = 'Question weight';
  SQuestionCorrectAnswer = 'Correct answer';
  SSectionResultsAvailable = 'Section details:';
  SSectionPercentCorrect = 'Result in percent';
  SSectionPoints = 'Points earned';
  SSectionQuestionCount = 'Number of questions';
  SSectionQuestionList = 'Question list';
  SMarkScale = 'Grading scale:';

{ TProfileList }

function TProfileList.GetCount: Integer;
begin
  Result := FProfiles.Count;
end;

function TProfileList.GetProfiles(Index: Integer): TProfile;
begin
  CheckProfileIndex(Index);
  Result := FProfiles[Index];
end;

procedure TProfileList.CheckProfileIndex(Index: Integer);
begin
  Assert( Index >= 0 );
  Assert( Index < Count );
end;

constructor TProfileList.Create;
begin
  inherited;
  FProfiles := TRawProfileList.Create;
end;

destructor TProfileList.Destroy;
begin
  FreeAndNil(FProfiles);
  inherited;
end;

procedure TProfileList.Add(Profile: TProfile);
begin
  FProfiles.AddSafely(Profile);
end;

function TProfileList.Extract(Index: Integer): TProfile;
begin
  CheckProfileIndex(Index);
  Result := FProfiles.Extract(FProfiles[Index]);
end;

{ TWorkConfiguration }

procedure TWorkConfiguration.SetQuestionsPerSection(Value: Integer);
begin
  if Value < 0 then
    raise Exception.CreateFmt('Incorrect QuestionsPerSection value: %d.', [Value]);
  FQuestionsPerSection := Value;
end;

procedure TWorkConfiguration.SetDurationMinutes(Value: Integer);
begin
  if Value < 0 then
    raise Exception.CreateFmt('Incorrect DurationMinutes value: %d.', [Value]);
  FDurationMinutes := Value;
end;

{ TResultPolicy }

procedure TResultPolicy.Assign(Source: TResultPolicy);
begin
  FResultsAvailable := Source.FResultsAvailable;

  FPercentCorrect := Source.FPercentCorrect;
  FPoints := Source.FPoints;
  FMark := Source.FMark;

  FQuestionResultsAvailable := Source.FQuestionResultsAvailable;
  FQuestionPercentCorrect := Source.FQuestionPercentCorrect;
  FQuestionPoints := Source.FQuestionPoints;
  FQuestionCorrectAnswer := Source.FQuestionCorrectAnswer;

  FSectionResultsAvailable := Source.FSectionResultsAvailable;
  FSectionPercentCorrect := Source.FSectionPercentCorrect;
  FSectionPoints := Source.FSectionPoints;
  FSectionQuestionCount := Source.FSectionQuestionCount;
  FSectionQuestionList := Source.FSectionQuestionList;
end;

{ TMarkScaleItem }

procedure TMarkScaleItem.Assign(Source: TMarkScaleItem);
begin
  FLowerBound := Source.FLowerBound;
  FMark := Source.FMark;
end;

function TMarkScaleItem.Clone: TMarkScaleItem;
begin
  Result := TMarkScaleItem.Create;
  try
    Result.Assign(Self);
  except
    Result.Free;
    raise;
  end;
end;

{ TMarkScale }

procedure TMarkScale.CheckItemIndex(Index: Integer);
begin
  Assert( Index >= 0 );
  Assert( Index < ItemCount );
end;

constructor TMarkScale.Create;
begin
  inherited;
  FItems := TMarkScaleItemList.Create;
end;

destructor TMarkScale.Destroy;
begin
  FreeAndNil(FItems);
  inherited;
end;

function TMarkScale.GetLowerBounds(Index: Integer): Single;
begin
  CheckItemIndex(Index);
  Result := FItems[Index].FLowerBound;
end;

function TMarkScale.IsEmpty: Boolean;
begin
  Result := ItemCount = 0;
end;

function TMarkScale.GetItemCount: Integer;
begin
  Result := FItems.Count;
end;

procedure TMarkScale.GetItems(Items: TMarkScaleItemList);
var
  Item: TMarkScaleItem;
begin
  for Item in FItems do
    Items.AddSafely(Item.Clone);
end;

function TMarkScale.GetMarks(Index: Integer): String;
begin
  CheckItemIndex(Index);
  Result := FItems[Index].FMark;
end;

function TMarkScale.PartRightToItemIndex(PartRight: Single): Integer;
var
  i: Integer;
begin
  if IsEmpty then
    Result := -1
  else
  begin
    Result := 0;
    for i := 1 to ItemCount-1 do
      if PartRight >= FItems[i].FLowerBound then
        Result := i
      else
        Break;
  end;
end;

function TMarkScale.PartRightToMark(PartRight: Single): String;
var
  ItemIndex: Integer;
begin
  ItemIndex := PartRightToItemIndex(PartRight);
  if ItemIndex = -1 then
    Result := ''
  else
    Result := FItems[ItemIndex].FMark;
end;

procedure TMarkScale.SetItems(Items: TMarkScaleItemList);
var
  i: Integer;
  Item: TMarkScaleItem;
begin
  if Items.Count > MAX_ITEMS then
    raise Exception.Create(SMarkScaleError);

  if Items.Count > 0 then
  begin
    if Items[0].FLowerBound <> 0 then
      raise Exception.Create(SMarkScaleError);
    for i := 1 to Items.Count-1 do
      if (Items[i].FLowerBound < Items[i-1].FLowerBound) or (Items[i].FLowerBound > 1) then
        raise Exception.Create(SMarkScaleError);
  end;

  FItems.Clear;
  for Item in Items do
    FItems.AddSafely(Item.Clone);
end;

{ TProfile }

constructor TProfile.Create;
begin
  inherited;
  FConfiguration := TWorkConfiguration.Create;
  FModifierList := TModifierList.Create;
  FResultPolicy := TResultPolicy.Create;
  FMarkScale := TMarkScale.Create;
end;

destructor TProfile.Destroy;
begin
  FreeAndNil(FConfiguration);
  FreeAndNil(FModifierList);
  FreeAndNil(FResultPolicy);
  FreeAndNil(FMarkScale);
  inherited;
end;

function RightAlignInteger(n, Width: Integer): String;
begin
  Result := StringReplace(Format('%' + IntToStr(Width) + 'd', [n]), ' ', '  ', [rfReplaceAll]);
end;

procedure TProfile.GetDescription(Strings: TStrings);
var
  IndentLevel: Integer = 0;

  procedure Add(const s: String);
  begin
    Strings.Add(StringOfChar(' ', IndentLevel*4) + s);
  end;

  procedure GetGeneralDescription;
  var
    i: Integer;
  begin
    if FConfiguration.QuestionsPerSection > 0 then
      Add(Format(SQuestionsPerSection, [FConfiguration.QuestionsPerSection]))
    else
      Add(SAllQuestions);
    if FConfiguration.ShuffleQuestions then
      Add(SShuffleQuestions);
    if FConfiguration.DurationMinutes > 0 then
      Add(Format(SDurationMinutes, [FConfiguration.DurationMinutes]));
    if FConfiguration.EditableAnswers then
      Add(SEditableAnswers);
    if FConfiguration.InstantAnswerCorrectness then
      Add(SInstantAnswerCorrectness);
    if FConfiguration.InstantTotalPercentCorrect then
      Add(SInstantTotalPercentCorrect);
    if FConfiguration.BrowsableQuestions then
      Add(SBrowsableQuestions);
    if FConfiguration.WeightCues then
      Add(SWeightCues);

    if FModifierList.Count > 0 then
    begin
      Add('');
      for i := 0 to FModifierList.Count-1 do
        Add(FModifierList[i].GetTitle);
    end;
  end;

  procedure GetResultPolicyDescription;
  begin
    if FResultPolicy.ResultsAvailable then
    begin
      Add('');
      Add(SResultsAvailable);
      Inc(IndentLevel);

      if FResultPolicy.PercentCorrect then
        Add(SPercentCorrect);
      if FResultPolicy.Mark then
        Add(SMark);
      if FResultPolicy.Points then
        Add(SPoints);

      if FResultPolicy.QuestionResultsAvailable then
      begin
        Add(SQuestionResultsAvailable);
        Inc(IndentLevel);
        if FResultPolicy.QuestionPercentCorrect then
          Add(SQuestionPercentCorrect);
        if FResultPolicy.QuestionCorrectAnswer then
          Add(SQuestionCorrectAnswer);
        if FResultPolicy.QuestionPoints then
          Add(SQuestionPoints);
        Dec(IndentLevel);
      end;

      if FResultPolicy.SectionResultsAvailable then
      begin
        Add(SSectionResultsAvailable);
        Inc(IndentLevel);
        if FResultPolicy.SectionPercentCorrect then
          Add(SSectionPercentCorrect);
        if FResultPolicy.SectionPoints then
          Add(SSectionPoints);
        if FResultPolicy.SectionQuestionCount then
          Add(SSectionQuestionCount);
        if FResultPolicy.SectionQuestionList then
          Add(SSectionQuestionList);
        Dec(IndentLevel);
      end;

      Dec(IndentLevel);
    end;
  end;

  procedure GetMarkScaleDescription;
  var
    i: Integer;
  begin
    if not FMarkScale.IsEmpty then
    begin
      Add('');
      Add(SMarkScale);
      Inc(IndentLevel);

      for i := 0 to FMarkScale.ItemCount-1 do
        Add(RightAlignInteger(Round(FMarkScale.LowerBounds[i]*100), 3) + '%  '
          + FMarkScale.Marks[i]);

      Dec(IndentLevel);
    end;
  end;

begin
  GetGeneralDescription;
  GetResultPolicyDescription;
  GetMarkScaleDescription;
end;

end.

